home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / SYSUTIL2.D < prev    next >
Encoding:
Modula Definition  |  1990-11-27  |  5.3 KB  |  141 lines
  1. DEFINITION MODULE SysUtil2;
  2.  
  3. (*
  4.  * SetJump/LongJump (globales GOTO), sowie Funktionen zum Erlangen des
  5.  * Supervisormodus und Kontrolle der Interruptlevel-Maske.
  6.  *
  7.  * 07.12.88  TT  Grunderstellung
  8.  * 13.06.90  TT  'SupervisorMode'/'UserMode' in 'EnterSupervisorMode'
  9.  *               und 'LeaveSupervisorMode' umbenannt, 'InSupervisorMode' neu.
  10.  *)
  11.  
  12.  
  13. FROM SYSTEM IMPORT WORD, ADDRESS, LONGWORD;
  14.  
  15. (*
  16.  * C-artige 'SetJmp' / 'LongJmp'
  17.  * -----------------------------
  18.  *
  19.  *   Diese aus der Sprache C bekannten Funktionen stellen ein "globales"
  20.  * GOTO dar. 'SetJump' deklariert ein "Label" und 'LongJump' führt den
  21.  * Sprung aus. Die Verwendung dieser Funktionen ist v.A. für Fehlerbehand-
  22.  * lungen sehr nützlich. So kann beispielsweise von einem tief verschachtel-
  23.  * ten Prozeduraufruf direkt zurück auf höher gelegenes Level zurückge-
  24.  * sprungen werden.
  25.  *   Zu beachten ist dabei, daß nie von einer "höheren" in eine "tiefer"
  26.  * verschachtelte Funktion gesprungen werden darf (z.B. von einer Prozedur
  27.  * in ihre lokale), da in einem solchen Fall der dazwischen notwendige
  28.  * Initialisierungsteil für die lokalen Daten fehlen würde. In der anderen
  29.  * Richtung werden lediglich alle lokalen Daten "weggeworfen", ähnlich der
  30.  * RETURN-Anweisung bei Modula-2.
  31.  *
  32.  * Beispiel:
  33.  *
  34.  *  VAR ljbuf1: JumpBuf;
  35.  *  PROCEDURE zwei;
  36.  *    PROCEDURE lokal;
  37.  *      BEGIN
  38.  *         IF fehler1 () THEN LongJump (ljbuf1, 1) END;
  39.  *      END lokal;
  40.  *    BEGIN (* von 'zwei' *)
  41.  *      lokal;
  42.  *      IF fehler2 () THEN LongJump (ljbuf1, 2) END;
  43.  *    END zwei;
  44.  *  PROCEDURE haupt;
  45.  *    BEGIN
  46.  *      CASE SetJump (ljbuf1) OF
  47.  *        0: (* Label wurde deklariert -> 'zwei' aufrufen: *)
  48.  *           zwei;
  49.  *           (* 'zwei' kehrte ohne Fehler zurück *)
  50.  *           zeige ('Kein Fehler.')
  51.  *      | 1: zeige ('Fehler in Prozedur "lokal" !')
  52.  *      | 2: zeige ('Fehler in Prozedur "zwei" !')
  53.  *      END;
  54.  *    END haupt;
  55.  *
  56.  * Im Beispiel wird zuerst 'haupt' ausgeführt. Diese installiert die Sprung-
  57.  * marke 'ljbuf1' und ruft dann 'zwei' auf. Jene Prozedur ruft 'lokal' auf,
  58.  * welche dann eine Operation durchführt, die ggf. einen Rücksprung zur
  59.  * 'SetJump'-Anweisung ausführt. Ist dies nicht der Fall, kann ebenso, nach
  60.  * Rückkehr zu 'zwei' diese Prozedur einen Rücksprung auslösen - im Gegensatz
  61.  * zum 'LongJump'-Aufruf in 'lokal' wird hier aber zur Kontrolle ein anderer
  62.  * Wert (2) zurückgeliefert. Wird auch dieser 'LongJump'-Aufruf nicht durch-
  63.  * geführt, kehrt 'zwei' normal zu 'haupt' zurück, wo "kein Fehler" signali-
  64.  * siert wird. In den anderen Fällen wird zu den anderen CASE-Marken gesprun-
  65.  * gen und ein entsprechender Fehler signalisiert.
  66.  *)
  67.  
  68. TYPE JumpBuf = RECORD
  69.                  pc: ADDRESS;
  70.                  ssp: LONGWORD;
  71.                  usp: LONGWORD;
  72.                  sr: WORD;
  73.                  d: ARRAY [1..7] OF LONGWORD;
  74.                  a: ARRAY [1..6] OF LONGWORD;
  75.                END;
  76.  
  77. PROCEDURE SetJump ( VAR hdl: JumpBuf ): INTEGER;
  78.   (*
  79.    * Setzt eine "globale" Rücksprungmarke.
  80.    * Das bedeutet, daß diese Prozedur nach ihrem Aufruf den Wert Null liefert.
  81.    * Wird dann später 'LongJump' (s.u.) mit demselben 'hdl' aufgerufen, wird
  82.    * das Programm wiedrum hinter 'SetJump' weitergeführt, wobei diese Proze-
  83.    * dur einen von Null verschiedenen Wert liefern wird.
  84.    *)
  85.  
  86. PROCEDURE LongJump ( VAR hdl: JumpBuf; rtnCode: INTEGER );
  87.   (*
  88.    * Führt einen Rücksprung zum Aufruf der zu 'hdl' gehörenden 'SetJump'-
  89.    * Funktion durch. 'SetJump' liefert dabei 'rtnCode'. 'rtnCode' darf nicht
  90.    * Null sein - ist dies trotzdem der Fall, wird stattdessen 1 geliefert.
  91.    *
  92.    * Restauriert D3-D7, A3-A7, PC und SR (incl. User-/Superv.-Modus und IRMask)
  93.    *)
  94.  
  95. (*
  96.  * Enter/LeaveSupervisorMode
  97.  * -------------------------
  98.  *   zum Erlangen des Supervisor-Modus und Rückkehr in den User-Modus.
  99.  * Nur im Supervisor-Modus lassen sich bestimmte Operationen durchführen,
  100.  * wie z.B. der Zugriff auf die Systemvariablen auf den Adressen zw. $400
  101.  * und $800 (gerade für solche Zugriffe bieten sich aber eher die Peek-
  102.  * und Poke-Funktionen aus dem Modul 'SysUtil1' an!).
  103.  * Auch kann alternativ die Funktion 'Calls.CallSupervisor' verwendet werden.
  104.  *
  105.  * Als Stack wird der aktuelle User-Stack verwendet.
  106.  *)
  107.  
  108. TYPE ModeBuf = LONGWORD;
  109.  
  110. PROCEDURE EnterSupervisorMode ( VAR hdl: ModeBuf );
  111. PROCEDURE LeaveSupervisorMode ( VAR hdl: ModeBuf );
  112. PROCEDURE InSupervisorMode (): BOOLEAN;
  113.   (*
  114.    * 'EnterSupervisorMode' darf auch im Supervisor-Modus aufgerufen werden,
  115.    * in dem Fall ändert sich nichts.
  116.    * Ein 'LeaveSupervisorMode'-Aufruf nur nach vorherigem Aufruf von
  117.    * 'EnterSupervisorMode' erfolgen!
  118.    * Beide Aufrufe müssen auf demselben "Scope-Level" erfolgen.
  119.    * Das heißt, daß sie nicht nur in der selben Prozedur, sondern auch auf
  120.    * dem selben Einrückungs-Level erfolgen müssen (also z.B. nicht die eine
  121.    * außerhalb einer FOR- und die andere innerhalb dieser Schleife).
  122.    *
  123.    * 'InSupervisorMode()' liefert TRUE, wenn sich das Programm gerade im
  124.    * Supervirsor-Modus befindet.
  125.    *)
  126.  
  127. TYPE IRLevel = [0..7];
  128.  
  129. PROCEDURE SetIRMask ( level: IRLevel );
  130.   (*
  131.    * Setzt, unabhängig vom Modus (User- o. Supervisor), die Interruptlevel-
  132.    * Maske (0-7).
  133.    *)
  134.  
  135. PROCEDURE IRMask (): IRLevel;
  136.   (*
  137.    * Liefert den aktuellen Wert der IR-Level-Maske.
  138.    *)
  139.  
  140. END SysUtil2.
  141.